home *** CD-ROM | disk | FTP | other *** search
/ Deutsche Edition 1 / Deutsche Edition 1.iso / amok / 051-060 / amok57 / oclock / oclock.mod < prev    next >
Text File  |  1993-11-04  |  8KB  |  243 lines
  1. (*---------------------------------------------------------------------------
  2.   :Program.     OClock.mod
  3.   :Contents.    Nice little analog clock
  4.   :Author.      Christian Stiens
  5.   :Address.     Heustiege 2, W-4710 Lüdinghausen
  6.   :Copyright.   PD
  7.   :Language.    Oberon
  8.   :Translator.  Amiga Oberon V2.01 [fbs]
  9.   :History.     V1.0, 24-Jul-91
  10. ---------------------------------------------------------------------------*)
  11.  
  12.  
  13. MODULE OClock;
  14.  
  15.   (* $RangeChk- $NilChk- $StackChk- $OvflChk- $ReturnChk- $CaseChk- *)
  16.  
  17.   IMPORT
  18.     I: Intuition,
  19.     e: Exec,
  20.     d: Dos,
  21.     g: Graphics,
  22.     s: SYSTEM;
  23.  
  24.   CONST
  25.     esc = 69;
  26.  
  27.   VAR
  28.     nw         : I.NewWindow;
  29.     win        : I.WindowPtr;
  30.     rp         : g.RastPortPtr;
  31.     im         : I.Image;
  32.     msg        : I.IntuiMessagePtr;
  33.     dragGad    : I.Gadget;
  34.     oldMin     : INTEGER;
  35.     x0,y0      : INTEGER;
  36.     i          : INTEGER;
  37.     hlx,mlx    : INTEGER;
  38.     hly,mly    : INTEGER;
  39.  
  40. (*-----------------------------------------------------------------------*)
  41.  
  42.   CONST
  43.     width   = 90;
  44.     height  = 45;
  45.     depth   = 2;
  46.  
  47.   TYPE
  48.     IntArray540 = ARRAY 540 OF INTEGER;
  49.  
  50.   (* $DataChip+ *)
  51.  
  52.   CONST OClockData = IntArray540(
  53.     00000U,00000U,01FFFU,0FE00U,00000U,00000U,
  54.     00000U,00007U,0F000U,003F8U,00000U,00000U,
  55.     00000U,000FCU,00063U,0C00FU,0C000U,00000U,
  56.     00000U,00780U,00066U,06000U,07800U,00000U,
  57.     00000U,03C00U,00060U,0C000U,00F00U,00000U,
  58.     00001U,0E060U,00063U,08001U,081E0U,00000U,
  59.     00007U,000F0U,00067U,0E003U,0C038U,00000U,
  60.     0001CU,00060U,00000U,00001U,0800EU,00000U,
  61.     00030U,00000U,00000U,00000U,00003U,00000U,
  62.     000E0U,00000U,00000U,00000U,00001U,0C000U,
  63.     00180U,00000U,00000U,00000U,00000U,06000U,
  64.     00300U,00000U,00000U,00000U,00000U,03000U,
  65.     00618U,00000U,00000U,00000U,00006U,01800U,
  66.     00C3CU,00000U,00000U,00000U,0000FU,00C00U,
  67.     01818U,00000U,00000U,00000U,00006U,00600U,
  68.     03000U,00000U,00000U,00000U,00000U,00300U,
  69.     03000U,00000U,00000U,00000U,00000U,00300U,
  70.     06000U,00000U,00000U,00000U,00000U,00180U,
  71.     06000U,00000U,00000U,00000U,00000U,00180U,
  72.     0C000U,00000U,00000U,00000U,00000U,000C0U,
  73.     0C3E0U,00000U,00000U,00000U,00001U,0F0C0U,
  74.     0C630U,00000U,00006U,00000U,00000U,018C0U,
  75.     0C3F0U,00000U,0000FU,00000U,00000U,0F0C0U,
  76.     0C030U,00000U,00006U,00000U,00000U,018C0U,
  77.     0C3E0U,00000U,00000U,00000U,00001U,0F0C0U,
  78.     0C000U,00000U,00000U,00000U,00000U,000C0U,
  79.     06000U,00000U,00000U,00000U,00000U,00180U,
  80.     06000U,00000U,00000U,00000U,00000U,00180U,
  81.     03000U,00000U,00000U,00000U,00000U,00300U,
  82.     03000U,00000U,00000U,00000U,00000U,00300U,
  83.     01818U,00000U,00000U,00000U,00006U,00600U,
  84.     00C3CU,00000U,00000U,00000U,0000FU,00C00U,
  85.     00618U,00000U,00000U,00000U,00006U,01800U,
  86.     00300U,00000U,00000U,00000U,00000U,03000U,
  87.     00180U,00000U,00000U,00000U,00000U,06000U,
  88.     000E0U,00000U,00000U,00000U,00001U,0C000U,
  89.     00030U,00000U,00000U,00000U,00003U,00000U,
  90.     0001CU,00030U,00000U,00003U,0000EU,00000U,
  91.     00007U,00078U,0001FU,00007U,08038U,00000U,
  92.     00001U,0E030U,00030U,00003U,001E0U,00000U,
  93.     00000U,03C00U,0003FU,00000U,00F00U,00000U,
  94.     00000U,00780U,00031U,08000U,07800U,00000U,
  95.     00000U,000FCU,0001FU,0000FU,0C000U,00000U,
  96.     00000U,00007U,0F000U,003F8U,00000U,00000U,
  97.     00000U,00000U,01FFFU,0FE00U,00000U,00000U,
  98.     00000U,00000U,00000U,00000U,00000U,00000U,
  99.     00000U,00000U,00FFFU,0FC00U,00000U,00000U,
  100.     00000U,00003U,0FF9CU,03FF0U,00000U,00000U,
  101.     00000U,0007FU,0FF99U,09FFFU,08000U,00000U,
  102.     00000U,003FFU,0FF9FU,03FFFU,0F000U,00000U,
  103.     00000U,01FDFU,0FF9CU,07FFFU,07E00U,00000U,
  104.     00000U,0FFCFU,0FF98U,01FFFU,03FC0U,00000U,
  105.     00003U,0FFDFU,0FFFFU,0FFFFU,07FF0U,00000U,
  106.     0000FU,0FFFFU,0FFFFU,0FFFFU,0FFFCU,00000U,
  107.     0001FU,0FFFFU,0FFFFU,0FFFFU,0FFFEU,00000U,
  108.     0007FU,0FFFFU,0FFFFU,0FFFFU,0FFFFU,08000U,
  109.     000FFU,0FFFFU,0FFFFU,0FFFFU,0FFFFU,0C000U,
  110.     001F7U,0FFFFU,0FFFFU,0FFFFU,0FFFDU,0E000U,
  111.     003F3U,0FFF0U,0E13EU,01C24U,0FFFCU,0F000U,
  112.     007F7U,0FFE6U,04F3CU,0C9E3U,0FFFDU,0F800U,
  113.     00FFFU,0FFE6U,04F3CU,0C9E1U,0FFFFU,0FC00U,
  114.     00FFFU,0FFF0U,0E106U,01C24U,0FFFFU,0FC00U,
  115.     01FFFU,0FFFFU,0FFFFU,0FFFFU,0FFFFU,0FE00U,
  116.     01FFFU,0FFFFU,0FFFFU,0FFFFU,0FFFFU,0FE00U,
  117.     03FFFU,0FFFFU,0FFFFU,0FFFFU,0FFFFU,0FF00U,
  118.     03C1FU,0FFFFU,0FFFFU,0FFFFU,0FFFEU,00F00U,
  119.     039CFU,0FFFFU,0FFF9U,0FFFFU,0FFFFU,0E700U,
  120.     03C0FU,0FFFFU,0FFF0U,0FFFFU,0FFFFU,00F00U,
  121.     03FCFU,0FFFFU,0FFF9U,0FFFFU,0FFFFU,0E700U,
  122.     03C1FU,0FFFFU,0FFFFU,0FFFFU,0FFFEU,00F00U,
  123.     03FFFU,0FFFFU,0FFFFU,0FFFFU,0FFFFU,0FF00U,
  124.     01FFFU,0FFFFU,0FFFFU,0FFFFU,0FFFFU,0FE00U,
  125.     01FFFU,0FFFFU,0FFFFU,0FFFFU,0FFFFU,0FE00U,
  126.     00FFFU,0FFFFU,0FFFFU,0FFFFU,0FFFFU,0FC00U,
  127.     00FFFU,0FFFFU,0FFFFU,0FFFFU,0FFFFU,0FC00U,
  128.     007F7U,0FFFFU,0FFFFU,0FFFFU,0FFFDU,0F800U,
  129.     003F3U,0FFFFU,0FFFFU,0FFFFU,0FFFCU,0F000U,
  130.     001F7U,0FFFFU,0FFFFU,0FFFFU,0FFFDU,0E000U,
  131.     000FFU,0FFFFU,0FFFFU,0FFFFU,0FFFFU,0C000U,
  132.     0007FU,0FFFFU,0FFFFU,0FFFFU,0FFFFU,08000U,
  133.     0001FU,0FFFFU,0FFFFU,0FFFFU,0FFFEU,00000U,
  134.     0000FU,0FFFFU,0FFFFU,0FFFFU,0FFFCU,00000U,
  135.     00003U,0FFEFU,0FFFFU,0FFFEU,0FFF0U,00000U,
  136.     00000U,0FFE7U,0FFE0U,0FFFEU,07FC0U,00000U,
  137.     00000U,01FEFU,0FFCFU,0FFFEU,0FE00U,00000U,
  138.     00000U,003FFU,0FFC0U,0FFFFU,0F000U,00000U,
  139.     00000U,0007FU,0FFCEU,07FFFU,08000U,00000U,
  140.     00000U,00003U,0FFE0U,0FFF0U,00000U,00000U,
  141.     00000U,00000U,00FFFU,0FC00U,00000U,00000U,
  142.     00000U,00000U,00000U,00000U,00000U,00000U);
  143.  
  144. (*-----------------------------------------------------------------------*)
  145.  
  146.   TYPE
  147.     Arr60 = ARRAY 60 OF SHORTINT;
  148.  
  149.   CONST
  150.     sinTab = Arr60(0,13,26,39,52,63,75,85,94,103,110,116,121,124,126,127,126,
  151.                  124,121,116,110,103,94,85,75,64,52,39,26,13,0,-13,-26,-39,
  152.                  -52,-63,-75,-85,-94,-103,-110,-116,-121,-124,-126,-127,-126,
  153.                  -124,-121,-116,-110,-103,-94,-85,-75,-64,-52,-39,-26,-13);
  154.  
  155. (*-----------------------------------------------------------------------*)
  156.  
  157.   PROCEDURE DrawZeiger(min,lx,ly: INTEGER);
  158.     VAR zx,zy : INTEGER;
  159.         si,co : INTEGER;
  160.   BEGIN
  161.     si := sinTab[min];
  162.     co := sinTab[(min+15) MOD 60];
  163.     zx := lx * si DIV 128;
  164.     zy := ly * co DIV 128;
  165.     g.SetAPen(rp,1);
  166.     g.Move(rp,x0,y0);
  167.     g.Draw(rp,x0+zx,y0-zy);
  168.     g.Move(rp,x0+1,y0);
  169.     g.Draw(rp,x0+zx+1,y0-zy);
  170.   END DrawZeiger;
  171.  
  172. (*-----------------------------------------------------------------------*)
  173.  
  174.   PROCEDURE ShowClock;
  175.     VAR hour,min: INTEGER;
  176.         sec,mic,day : LONGINT;
  177.   BEGIN
  178.     I.CurrentTime(sec,mic);
  179.     sec := sec MOD 86400;
  180.     min := SHORT((sec MOD 3600) DIV 60);
  181.     IF min # oldMin THEN
  182.       hour := SHORT((sec DIV 720) MOD 60);
  183.       I.DrawImage(rp,im,0,0);
  184.       DrawZeiger(hour,hlx,hly);
  185.       DrawZeiger(min,mlx,mly);
  186.       oldMin := min;
  187.     END;
  188.   END ShowClock;
  189.  
  190. (*-----------------------------------------------------------------------*)
  191.  
  192. BEGIN
  193.  
  194.   oldMin := -1;
  195.  
  196.   im.width     := width;
  197.   im.height    := height;
  198.   im.depth     := depth;
  199.   im.imageData := s.ADR(OClockData);
  200.   im.planePick := SHORTSET{0,1};
  201.  
  202.   dragGad.flags      := {I.gRelWidth,I.gRelHeight} + I.gadgHNone;
  203.   dragGad.gadgetType := I.wDragging;
  204.   dragGad.activation := {I.gadgImmediate};
  205.  
  206.   nw.leftEdge    := 50;
  207.   nw.topEdge     := 30;
  208.   nw.flags       := LONGSET{I.borderless};
  209.   nw.idcmpFlags  := LONGSET{I.rawKey};
  210.   nw.type        := {I.wbenchScreen};
  211.   nw.width       := width;
  212.   nw.height      := height;
  213.   nw.firstGadget := s.ADR(dragGad);
  214.  
  215.   win := I.OpenWindow(nw);
  216.   IF win = NIL THEN HALT(20) END;
  217.  
  218.   rp := win.rPort;
  219.  
  220.   x0 := width DIV 2; y0 := height DIV 2;
  221.   hlx := (width * 16) DIV 55; mlx := (width * 16) DIV 40;
  222.   hly := (height* 16) DIV 55; mly := (height* 16) DIV 40;
  223.  
  224.   LOOP
  225.     ShowClock;
  226.     msg := e.GetMsg(win.userPort);
  227.     WHILE msg # NIL DO
  228.       IF (I.rawKey IN msg.class) & (msg.code = esc) THEN
  229.         e.ReplyMsg(msg); HALT(0)
  230.       END;
  231.       e.ReplyMsg(msg);
  232.       msg := e.GetMsg(win.userPort);
  233.     END;
  234.     d.Delay(d.ticksPerSecond);
  235.   END;
  236.  
  237. CLOSE
  238.  
  239.   IF win # NIL THEN I.CloseWindow(win) END;
  240.  
  241. END OClock.
  242.  
  243.